home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / sound / mtc / mtc.bas < prev    next >
Encoding:
BASIC Source File  |  1994-09-17  |  32.0 KB  |  951 lines
  1. Option Explicit
  2.  
  3. Global Frame_Mode As Integer   '24,25,29,30
  4. Global TC_Type As Integer      '0,  1, 2, 3
  5. Global MTC_Time As Long        'External Time in ms.
  6. Global Ms_per_QF As Single     'Ms. per Quarter Frame (1000/Frame_Mode)
  7. Global QF_Counter As Integer   '0...7  (Quarter Frame Message Counter)
  8.  
  9. Global hhh As Integer          'Actual Hours
  10. Global mmm As Integer          'Minutes
  11. Global sss As Integer          'Seconds
  12. Global fff As Integer          'Frames
  13.  
  14. Global disp_hhh As Integer     'Display Hours
  15. Global disp_mmm As Integer     'Minutes
  16. Global disp_sss As Integer     'Seconds
  17. Global disp_fff As Integer     'Frames
  18.  
  19. Global flgStop As Integer
  20. Global flgDown As Integer
  21. Global flgReadStop As Integer
  22.  
  23. 'Midi Device Handles
  24. Global hMidiIn As Integer               'usually 966 or 986
  25. Global hMidiOut As Integer              '   "        "   "
  26. Global Const NO_HANDLE = -1000          'Device closed
  27.      
  28. 'InBuffer parameters (circular buffer)
  29. Global ReadIndex As Integer               'Where to read from buffer
  30. Global WriteIndex As Integer              'where to write into buffer
  31. Global BuffCounter As Integer           'N. of messages in buffer
  32. Global InBuffer(1023) As Long           'Buffer (0...1023)
  33. Global Const BUFFSIZE = 1024            'max. 1024 messages
  34.  
  35. 'If InBuffer is full and a message arrives, increment NumErrors
  36. Global NumErrors As Long
  37.  
  38. 'Wait for this flag to be active before change InBuffer Parameters
  39. Global flgChangeIt As Integer        'True=changes allowed, False=not allowed
  40.  
  41. 'Device ID
  42. Global InDevice As Integer          'Midi In Device
  43. Global OutDevice As Integer         'Midi Out Device
  44.  
  45. Global flgGoodbye As Integer        'If true exit polling loop
  46.                                     'For API Functions Calls
  47. Global ret As Integer
  48.  
  49.  
  50. ''''''''''  General Constants '''''''''''''''
  51.  
  52. ' Booleans
  53. Global Const YES = True
  54. Global Const NO = False
  55.  
  56. ' DragOver
  57. Global Const ENTER = 0
  58. Global Const LEAVE = 1
  59.  
  60. ' Colors
  61. Global Const BLACK = &H0&
  62. Global Const RED = &HFF&
  63. Global Const GREEN = &HFF00&
  64. Global Const YELLOW = &HFFFF&
  65. Global Const BLUE = &HFF0000
  66. Global Const MAGENTA = &HFF00FF
  67. Global Const CYAN = &HFFFF00
  68. Global Const WHITE = &HFFFFFF
  69. Global Const GRAY = &HC0C0C0
  70. Global Const BURDEOS = &H80
  71. Global Const DARKGRREN = &H8000
  72. Global Const DARKBLUE = &H800000
  73. Global Const MIDLEGREEN = &H8080
  74. Global Const LILA = &H800080
  75. Global Const VERDFOSC = &H808000
  76. Global Const DARKGREY = &H808080
  77.  
  78. 'MousePointer
  79. Global Const DEFAULT = 0        ' 0 - Default
  80. Global Const ARROW = 1          ' 1 - Arrow
  81. Global Const CROSSHAIR = 2      ' 2 - Cross
  82. Global Const IBEAM = 3          ' 3 - I-Beam
  83. Global Const ICON_POINTER = 4   ' 4 - Icon
  84. Global Const SIZE_POINTER = 5   ' 5 - Size
  85. Global Const SIZE_NE_SW = 6     ' 6 - Size NE SW
  86. Global Const SIZE_N_S = 7       ' 7 - Size N S
  87. Global Const SIZE_NW_SE = 8     ' 8 - Size NW SE
  88. Global Const SIZE_W_E = 9       ' 9 - Size W E
  89. Global Const UP_ARROW = 10      ' 10 - Up Arrow
  90. Global Const HOURGLASS = 11     ' 11 - Hourglass
  91. Global Const NO_DROP = 12       ' 12 - No drop
  92.  
  93. ' MsgBox parameters
  94. Global Const MB_OK = 0                 ' OK button only
  95. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  96. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  97. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  98. Global Const MB_YESNO = 4              ' Yes and No buttons
  99. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  100.  
  101. Global Const MB_ICONSTOP = 16          ' Critical message
  102. Global Const MB_ICONQUESTION = 32      ' Warning query
  103. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  104. Global Const MB_ICONINFORMATION = 64   ' Information message
  105.  
  106. Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
  107. Global Const MB_DEFBUTTON1 = 0         ' First button is default
  108. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  109. Global Const MB_DEFBUTTON3 = 512       ' Third button is default
  110. Global Const MB_SYSTEMMODAL = 4096      'System Modal
  111.  
  112. ' MsgBox return values
  113. Global Const IDOK = 1                  ' OK button pressed
  114. Global Const IDCANCEL = 2              ' Cancel button pressed
  115. Global Const IDABORT = 3               ' Abort button pressed
  116. Global Const IDRETRY = 4               ' Retry button pressed
  117. Global Const IDIGNORE = 5              ' Ignore button pressed
  118. Global Const IDYES = 6                 ' Yes button pressed
  119. Global Const IDNO = 7                  ' No button pressed
  120.  
  121. ' Key Codes
  122. Global Const KEY_LBUTTON = &H1
  123. Global Const KEY_RBUTTON = &H2
  124. Global Const KEY_CANCEL = &H3
  125. Global Const KEY_MBUTTON = &H4    ' NOT contiguous with L & R BUTTON
  126. Global Const KEY_BACK = &H8
  127. Global Const KEY_TAB = &H9
  128. Global Const KEY_CLEAR = &HC
  129. Global Const KEY_RETURN = &HD
  130. Global Const KEY_SHIFT = &H10
  131. Global Const KEY_CONTROL = &H11
  132. Global Const KEY_MENU = &H12
  133. Global Const KEY_PAUSE = &H13
  134. Global Const KEY_CAPITAL = &H14
  135. Global Const KEY_ESCAPE = &H1B
  136. Global Const KEY_SPACE = &H20
  137. Global Const KEY_PRIOR = &H21
  138. Global Const KEY_NEXT = &H22
  139. Global Const KEY_END = &H23
  140. Global Const KEY_HOME = &H24
  141. Global Const KEY_LEFT = &H25
  142. Global Const KEY_UP = &H26
  143. Global Const KEY_RIGHT = &H27
  144. Global Const KEY_DOWN = &H28
  145. Global Const KEY_SELECT = &H29
  146. Global Const KEY_PRINT = &H2A
  147. Global Const KEY_EXECUTE = &H2B
  148. Global Const KEY_SNAPSHOT = &H2C
  149. Global Const KEY_INSERT = &H2D
  150. Global Const KEY_DELETE = &H2E
  151. Global Const KEY_HELP = &H2F
  152.  
  153. ' KEY_A thru KEY_Z are the same as their ASCII equivalents: 'A' thru 'Z'
  154. ' KEY_0 thru KEY_9 are the same as their ASCII equivalents: '0' thru '9'
  155.  
  156. Global Const KEY_NUMPAD0 = &H60
  157. Global Const KEY_NUMPAD1 = &H61
  158. Global Const KEY_NUMPAD2 = &H62
  159. Global Const KEY_NUMPAD3 = &H63
  160. Global Const KEY_NUMPAD4 = &H64
  161. Global Const KEY_NUMPAD5 = &H65
  162. Global Const KEY_NUMPAD6 = &H66
  163. Global Const KEY_NUMPAD7 = &H67
  164. Global Const KEY_NUMPAD8 = &H68
  165. Global Const KEY_NUMPAD9 = &H69
  166. Global Const KEY_MULTIPLY = &H6A
  167. Global Const KEY_ADD = &H6B
  168. Global Const KEY_SEPARATOR = &H6C
  169. Global Const KEY_SUBTRACT = &H6D
  170. Global Const KEY_DECIMAL = &H6E
  171. Global Const KEY_DIVIDE = &H6F
  172. Global Const KEY_F1 = &H70
  173. Global Const KEY_F2 = &H71
  174. Global Const KEY_F3 = &H72
  175. Global Const KEY_F4 = &H73
  176. Global Const KEY_F5 = &H74
  177. Global Const KEY_F6 = &H75
  178. Global Const KEY_F7 = &H76
  179. Global Const KEY_F8 = &H77
  180. Global Const KEY_F9 = &H78
  181. Global Const KEY_F10 = &H79
  182. Global Const KEY_F11 = &H7A
  183. Global Const KEY_F12 = &H7B
  184. Global Const KEY_F13 = &H7C
  185. Global Const KEY_F14 = &H7D
  186. Global Const KEY_F15 = &H7E
  187. Global Const KEY_F16 = &H7F
  188.  
  189. Global Const KEY_NUMLOCK = &H90
  190.  
  191. Global Const SHIFT_MASK = 1
  192. Global Const CTRL_MASK = 2
  193. Global Const ALT_MASK = 4
  194.  
  195. Global Const LEFT_BUTTON = 1
  196. Global Const RIGHT_BUTTON = 2
  197. Global Const MIDDLE_BUTTON = 4
  198.  
  199. 'SYSTEM Errors
  200. Global Const MMSYSERR_BASE = 0
  201. Global Const MMSYSERR_NOERROR = 0                        ' cap error
  202. Global Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1)        ' error sense especificar
  203. Global Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)  ' ID de dispositiu err≥nia
  204. Global Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)   ' no es pot activar el dispositiu
  205. Global Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)    ' el dispositiu ja estα activat
  206. Global Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)  ' Handle de dispositiu incorrecte
  207. Global Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)     ' no existeix el driver del dispositiu
  208. Global Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)        ' no hi ha prou mem≥ria
  209. Global Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8) ' funci≤ no suportada
  210. Global Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)    ' error fora de marge
  211. Global Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10)   ' flag passat incorrecte
  212. Global Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)  ' parαmetre passat incorrecte
  213. Global Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 11)   ' ·ltim error del marge
  214.  
  215.  
  216. 'MIDI Errors
  217. Global Const MIDIERR_BASE = 64
  218. Global Const MIDIERR_UNPREPARED = (MIDIERR_BASE + 0)     ' capτalera no preparada (SYSEX)
  219. Global Const MIDIERR_STILLPLAYING = (MIDIERR_BASE + 1)   ' play no ha acabat
  220. Global Const MIDIERR_NOMAP = (MIDIERR_BASE + 2)          ' no hi ha el mapa MIDI
  221. Global Const MIDIERR_NOTREADY = (MIDIERR_BASE + 3)       ' el hardware estα ocupat
  222. Global Const MIDIERR_NODEVICE = (MIDIERR_BASE + 4)       ' el port estα desconectat
  223. Global Const MIDIERR_INVALIDSETUP = (MIDIERR_BASE + 5)   ' setup incorrecte
  224. Global Const MIDIERR_LASTERROR = (MIDIERR_BASE + 5)      ' ·ltim error del marge
  225.  
  226. 'tipus de data de MIDI audio
  227. Global Const MIDIPATCHSIZE = 128
  228.  
  229.  
  230. 'MISSATGES
  231.  
  232. 'missatges de MIDI Input
  233. Global Const MM_MIM_OPEN = &H3C1
  234. Global Const MM_MIM_CLOSE = &H3C2
  235. Global Const MM_MIM_DATA = &H3C3
  236. Global Const MM_MIM_LONGDATA = &H3C4
  237. Global Const MM_MIM_ERROR = &H3C5
  238. Global Const MM_MIM_LONGERROR = &H3C6
  239.  
  240. 'missatges de MIDI Output
  241. Global Const MM_MOM_OPEN = &H3C7
  242. Global Const MM_MOM_CLOSE = &H3C8
  243. Global Const MM_MOM_DONE = &H3C9
  244.  
  245.  
  246. 'missatges de MIDI callback
  247. Global Const MIM_OPEN = MM_MIM_OPEN
  248. Global Const MIM_CLOSE = MM_MIM_CLOSE
  249. Global Const MIM_DATA = MM_MIM_DATA
  250. Global Const MIM_LONGDATA = MM_MIM_LONGDATA
  251. Global Const MIM_ERROR = MM_MIM_ERROR
  252. Global Const MIM_LONGERROR = MM_MIM_LONGERROR
  253. Global Const MOM_OPEN = MM_MOM_OPEN
  254. Global Const MOM_CLOSE = MM_MOM_CLOSE
  255. Global Const MOM_DONE = MM_MOM_DONE
  256.  
  257. ' device ID del mapa MIDI
  258. Global Const MIDIMAPPER = (-1)
  259. Global Const MIDI_MAPPER = (-1)
  260.  
  261. ' flags per wFlags a midiOutCachePatches(), midiOutCacheDrumPatches()
  262. Global Const MIDI_CACHE_ALL = 1
  263. Global Const MIDI_CACHE_BESTFIT = 2
  264. Global Const MIDI_CACHE_QUERY = 3
  265. Global Const MIDI_UNCACHE = 4
  266.  
  267.  
  268. ' flags usats a waveOutOpen(), waveInOpen(), midiInOpen(), and
  269. ' midiOutOpen() per especificar el tipus de parαmetre dwCallback.
  270.  
  271. Global Const CALLBACK_TYPEMASK = &H70000         ' callback de tipus mask
  272. Global Const CALLBACK_NULL = &H0&                ' cap callback
  273. Global Const CALLBACK_WINDOW = &H10000           ' dwCallback Θs HWND (finestra)
  274. Global Const CALLBACK_TASK = &H20000             ' dwCallback Θs HTASK (tasca)
  275. Global Const CALLBACK_FUNCTION = &H30000         ' dwCallback Θs FARPROC (funci≤)
  276.  
  277.  
  278. '    IDs de fabricants i productes
  279. '    Usat com wMid i wPid a WAVEOUTCAPS, WAVEINCAPS,
  280. '    MIDIOUTCAPS, MIDIINCAPS, AUXCAPS, JOYCAPS
  281.  
  282. ' IDs de fabricants
  283. Global Const MM_MICROSOFT = 1                 ' Microsoft Corp.
  284.  
  285. ' IDs de productes
  286. Global Const MM_MIDI_MAPPER = 1               ' MIDI Mapper
  287. Global Const MM_WAVE_MAPPER = 2               ' Wave Mapper
  288. Global Const MM_SNDBLST_MIDIOUT = 3           ' Sound Blaster MIDI output port
  289. Global Const MM_SNDBLST_MIDIIN = 4            ' Sound Blaster MIDI input port
  290. Global Const MM_SNDBLST_SYNTH = 5             ' Sound Blaster internal synthesizer
  291. Global Const MM_SNDBLST_WAVEOUT = 6           ' Sound Blaster waveform output
  292. Global Const MM_SNDBLST_WAVEIN = 7            ' Sound Blaster waveform input
  293. Global Const MM_ADLIB = 9                     ' Ad Lib-compatible synthesizer
  294. Global Const MM_MPU401_MIDIOUT = 10           ' MPU401-compatible MIDI output port
  295. Global Const MM_MPU401_MIDIIN = 11            ' MPU401-compatible MIDI input port
  296. Global Const MM_PC_JOYSTICK = 12              ' Joystick adapter
  297.  
  298. ' flags per wTechnology a MIDIOUTCAPS
  299. Global Const MOD_MIDIPORT = 1    ' port hardware
  300. Global Const MOD_SYNTH = 2       ' sintetitzador intern genΦric
  301. Global Const MOD_SQSYNTH = 3     ' sintet. intern d'ona quadrada
  302. Global Const MOD_FMSYNTH = 4     ' sintet. intern FM
  303. Global Const MOD_MAPPER = 5      ' mapa MIDI
  304.  
  305. ' flags per dwSupport a MIDIOUTCAPS
  306. Global Const MIDICAPS_VOLUME = &H1             ' suporta control de volum
  307. Global Const MIDICAPS_LRVOLUME = &H2           ' suporta control independent esquerra/dreta
  308. Global Const MIDICAPS_CACHE = &H4              ' suporta cache de patch
  309.  
  310.  
  311. ' estructura de les capacitats del dispositiu MIDI output
  312. Type MidiOutCaps
  313.     wMid As Integer                ' ID del fabricant
  314.     wPid As Integer                ' ID del producte
  315.     vDriverVersion As Integer      ' versi≤ del driver
  316.     szPname As String * 32         ' nom del producte (string acabat en NULL)
  317.     wTechnology As Integer         ' tipus de dispositiu
  318.     wVoices As Integer             ' n. de veus (nomΘs sintet. intern)
  319.     wNotes As Integer              ' max n. de notes (nomΘs sintet. intern)
  320.     wChannelMask As Integer        ' canals utilitzables (nomΘs sintet. intern)
  321.     dwSupport As Long              ' controls extres suportats (volum, etc)
  322. End Type
  323.  
  324.  
  325. ' estructura de les capacitats del dispositiu MIDI input
  326. Type MidiInCaps
  327.     wMid As Integer                ' ID del fabricant
  328.     wPid As Integer                ' ID del producte
  329.     vDriverVersion As Integer      ' versi≤ del driver
  330.     szPname As String * 32         ' nom del producte (string acabat en NULL)
  331. End Type
  332.  
  333.  
  334. ' flags per dwFlags a MIDIHDR
  335. Global Const MHDR_DONE = &H1                   ' bit que indica operaci≤ completada
  336. Global Const MHDR_PREPARED = &H2               ' bit que indica que el header estα preparat
  337. Global Const MHDR_INQUEUE = &H4                ' bit reservat pel driver
  338.  
  339. ' header d'un bloc de data MIDI (SYSEX)
  340. Type MIDIHDR
  341.     lpData As Long                    ' pointer a un bloc de data
  342.     dwBufferLength As Long            ' dimensions del buffer
  343.     dwBytesRecorded As Long           ' n. de Bytes gravats (nomΘs per Input)
  344.     dwUser As Long                    ' utilitzable per l'usuari
  345.     dwFlags As Long                   ' flags (veure les definicions anteriors)
  346.     lpNext As Long                    ' reservat pel driver
  347.     reserved As Long                  ' reservat pel driver
  348. End Type
  349.  
  350. ' tipus de data que utilitza windows per enviar missatges midi
  351. Type MidiShortMsg
  352.     dwTimestamp     As Long   'temps en que s'ha rebut el missatge (ms. desde Start)
  353.     dwMidiMsg       As Long   'missatge
  354. End Type
  355.  
  356. ' Funcions MIDI OUT
  357. 'n. de dispositius Midi Output?
  358. Declare Function midiOutGetNumDevs% Lib "MMSYSTEM.DLL" ()
  359. 'capacitats d'un dispositiu Midi Output en concret?
  360. Declare Function midiOutGetDevCaps% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpCaps As MidiOutCaps, ByVal uSize%)
  361. 'Volum (pregunta)
  362. Declare Function midiOutGetVolume% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpdwVolume&)
  363. 'Volum (assigna)
  364. Declare Function midiOutSetVolume% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, ByVal dwVolume&)
  365. 'Texte d'un error MidiOut
  366. Declare Function midiOutGetErrorText% Lib "MMSYSTEM.DLL" (ByVal uError%, ByVal lpText$, ByVal uSize%)
  367. 'Obre un dispositiu MIDI
  368. Declare Function midiOutOpen% Lib "MMSYSTEM.DLL" (lphMidiOut As Integer, ByVal uDeviceID%, ByVal dwCallback&, ByVal dwInstance&, ByVal dwFlags&)
  369. 'Tanca un dispositiu MIDI
  370. Declare Function midiOutClose% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%)
  371. 'Prepara un header per rebre SYSEX
  372. Declare Function midiOutPrepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  373. 'Desprepara un header
  374. Declare Function midiOutUnprepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  375. 'Envia un missatge Midi normal pel Midi Out (3 Bytes)
  376. Declare Function midiOutShortMsg% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal dwMsg&)
  377. 'Envia un missatge llarg (SYSEX) pel Midi Out
  378. Declare Function midiOutLongMsg% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  379. 'Reset al dispositiu Midi Out
  380. Declare Function midiOutReset% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%)
  381. 'Cache els patches de sons
  382. Declare Function midiOutCachePatches% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uBank%, lpwPatchArray%, ByVal uFlags%)
  383. 'Cache els patches de drums
  384. Declare Function midiOutCacheDrumPatches% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uPatch%, lpwKeyArray%, ByVal uFlags%)
  385. 'Pregunta ID d'un dispositiu
  386. Declare Function midiOutGetID% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpuDeviceID%)
  387. 'Envia un Byte pel Midi Out
  388. Declare Function midiOutMessage& Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uMessage%, ByVal dw1&, ByVal dw2&)
  389.  
  390. 'Funcions MIDI IN
  391. Declare Function midiInGetNumDevs% Lib "MMSYSTEM.DLL" ()
  392. Declare Function midiInGetDevCaps% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpCaps As MidiInCaps, ByVal uSize%)
  393. Declare Function midiInGetErrorText% Lib "MMSYSTEM.DLL" (ByVal uError%, ByVal lpText$, ByVal uSize%)
  394. Declare Function midiInOpen% Lib "MMSYSTEM.DLL" (lphMidiIn As Integer, ByVal uDeviceID%, ByVal dwCallback&, ByVal dwInstance&, ByVal dwFlags&)
  395. Declare Function midiInClose% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  396. Declare Function midiInPrepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  397. Declare Function midiInUnprepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  398. Declare Function midiInAddBuffer% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  399. Declare Function midiInStart% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  400. Declare Function midiInStop% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  401. Declare Function midiInReset% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  402. Declare Function midiInGetID% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpuDeviceID%)
  403. Declare Function midiInMessage& Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, ByVal uMessage%, ByVal dw1&, ByVal dw2&)
  404.  
  405. ' Temps del sistema en alta resoluci≤ (Multimedia)
  406. Declare Function timeGetTime& Lib "mmsystem" ()
  407.  
  408. Sub Display_Adjust ()
  409.     Dim st As String
  410.  
  411.     While disp_fff >= Frame_Mode
  412.         disp_fff = disp_fff - Frame_Mode
  413.         disp_sss = disp_sss + 1
  414.     Wend
  415.  
  416.     While disp_sss >= 60
  417.         disp_sss = disp_sss - 60
  418.         disp_mmm = disp_mmm + 1
  419.     Wend
  420.  
  421.     While disp_mmm >= 60
  422.         disp_mmm = disp_mmm - 60
  423.         disp_hhh = disp_hhh + 1
  424.     Wend
  425.  
  426.     While disp_hhh >= 24
  427.         disp_hhh = disp_hhh - 24
  428.     Wend
  429.  
  430.     While disp_fff < 0
  431.         disp_fff = disp_fff + Frame_Mode
  432.         disp_sss = disp_sss - 1
  433.     Wend
  434.  
  435.     While disp_sss < 0
  436.         disp_sss = disp_sss + 60
  437.         disp_mmm = disp_mmm - 1
  438.     Wend
  439.  
  440.     While disp_mmm < 0
  441.         disp_mmm = disp_mmm + 60
  442.         disp_hhh = disp_hhh - 1
  443.     Wend
  444.  
  445.     While disp_hhh < 0
  446.         disp_hhh = disp_hhh + 24
  447.     Wend
  448.  
  449.     st = Format$(disp_hhh, "00")
  450.     If MTCForm.txtHours.Caption <> st Then MTCForm.txtHours.Caption = st
  451.     st = Format$(disp_mmm, "00")
  452.     If MTCForm.txtMinutes.Caption <> st Then MTCForm.txtMinutes.Caption = st
  453.     st = Format$(disp_sss, "00")
  454.     If MTCForm.txtSeconds.Caption <> st Then MTCForm.txtSeconds.Caption = st
  455.     MTCForm.txtFrames.Caption = Format$(disp_fff, "00")
  456. End Sub
  457.  
  458. Sub Dlg_Alert (m$)
  459.      Beep
  460.      MsgBox m$, MB_OK + MB_ICONEXCLAMATION, "ALERT"
  461. End Sub
  462.  
  463. Sub Erase_Display ()
  464.     MTCForm.txtHours = "--"
  465.     MTCForm.txtMinutes = "--"
  466.     MTCForm.txtSeconds = "--"
  467.     MTCForm.txtFrames = "--"
  468. End Sub
  469.  
  470. Function IsNumber (kk As Integer)
  471.     Select Case kk
  472.         Case Asc("0") To Asc("9")
  473.             IsNumber = True
  474.         Case KEY_NUMPAD0 To KEY_NUMPAD9
  475.             IsNumber = True
  476.         Case Else
  477.             IsNumber = False
  478.     End Select
  479. End Function
  480.  
  481. Function KeyToNumber (KeyCode) As Integer
  482.     If KeyCode >= Asc("0") And KeyCode <= Asc("9") Then
  483.         KeyToNumber = KeyCode - Asc("0")
  484.     ElseIf KeyCode >= KEY_NUMPAD0 And KeyCode <= KEY_NUMPAD9 Then
  485.         KeyToNumber = KeyCode - KEY_NUMPAD0
  486.     Else
  487.         KeyToNumber = -1
  488.     End If
  489. End Function
  490.  
  491. 'Tanca el port Midi In
  492. Sub MidiIn_Close ()
  493.     If hMidiIn <> NO_HANDLE Then
  494.         MTCForm.MidiHook.Message(MIM_DATA) = False
  495.  
  496.         ret = midiInStop(hMidiIn)
  497.         If ret <> 0 Then
  498.             Alerta_MidiError (ret)
  499.             Exit Sub
  500.         End If
  501.  
  502.         ret = midiInClose(hMidiIn)
  503.         hMidiIn = NO_HANDLE
  504.         If ret <> 0 Then
  505.             Alerta_MidiError (ret)
  506.             Exit Sub
  507.         End If
  508.     End If
  509. End Sub
  510.  
  511. 'Obre un port Midi In
  512. Sub MidiIn_Open (nDevice)
  513.     MTCForm.MidiHook.HwndHook = MTCForm.hWnd
  514.     MTCForm.MidiHook.Message(MIM_DATA) = True
  515.  
  516.     MidiIn_Close
  517.  
  518.     ret = midiInOpen(hMidiIn, nDevice, MTCForm.hWnd, 0, CALLBACK_WINDOW)
  519.     If ret <> 0 Then
  520.         Alerta_MidiError (ret)
  521.         hMidiIn = NO_HANDLE
  522.         Exit Sub
  523.     End If
  524.  
  525.     ret = midiInStart(hMidiIn)
  526.         If ret <> 0 Then
  527.             Alerta_MidiError (ret)
  528.             ret = midiInClose(hMidiIn)
  529.         Exit Sub
  530.     End If
  531. End Sub
  532.  
  533. 'Llegeix un missatge guardat a InBuffer
  534. 'Si no hi ha cap missatge torna 0
  535. Function MidiIn_Read () As Long
  536.     Dim Msg As Long
  537.  
  538.     If BuffCounter = 0 Then
  539.         MidiIn_Read = 0&
  540.         Exit Function
  541.     End If
  542.  
  543.     Do                           'Wait que flgChangeIt sigui True
  544.         If flgChangeIt = True Then
  545.             flgChangeIt = False
  546.             Exit Do              'surt del bucle
  547.         End If
  548.         DoEvents
  549.     Loop
  550.  
  551.     MidiIn_Read = InBuffer(ReadIndex)
  552.     ReadIndex = ReadIndex + 1
  553.     If ReadIndex = BUFFSIZE Then ReadIndex = 0     'D≤na la volta
  554.     BuffCounter = BuffCounter - 1
  555.     flgChangeIt = True
  556. End Function
  557.  
  558. 'Tanca Midi Out
  559. Sub MidiOut_Close ()
  560.  
  561.     If hMidiOut <> NO_HANDLE Then
  562.         ret = midiOutClose(hMidiOut)
  563.         If ret <> 0 Then
  564.             Alerta_MidiError (ret)
  565.             Exit Sub
  566.         End If
  567.         hMidiOut = NO_HANDLE
  568.     End If
  569. End Sub
  570.  
  571. 'Obre un dispositiu Midi Out
  572. Sub MidiOut_Open (nDevice)
  573.     MidiOut_Close
  574.     ret = midiOutOpen(hMidiOut, nDevice, 0, 0, 0)
  575.     If ret <> 0 Then
  576.         Alerta_MidiError (ret)
  577.         Exit Sub
  578.     End If
  579. End Sub
  580.  
  581. 'Envia un codi pel Midi Out
  582. Function MidiOut_Write (Msg As Long) As Integer
  583.  
  584.     MidiOut_Write = True
  585.  
  586.     ret = midiOutShortMsg(hMidiOut, Msg)
  587.     If ret <> 0 Then
  588.         Alerta_MidiError (ret)
  589.         MidiOut_Write = False
  590.         Exit Function
  591.     End If
  592.     MTCForm.OutShow.Caption = "u"
  593. End Function
  594.  
  595. Sub MTC_Read ()
  596.     Dim Msg As Long, dd As Integer, oldt As Long, newt As Long
  597.     Dim ln As Integer, Expected As Integer
  598.     Dim flgCatching As Integer, tt As Integer, st As String
  599.     Dim h As Integer, m As Integer, s As Integer, f As Integer
  600.  
  601.     Erase_Display
  602.     flgCatching = True
  603.     Expected = &H0
  604.     flgReadStop = False
  605.  
  606.     oldt = timeGetTime()
  607.     While flgReadStop = False
  608.         newt = timeGetTime()
  609.  
  610.         If newt - oldt > 3000 Then   '3 segons
  611.             Erase_Display
  612.             flgCatching = True
  613.             Expected = &H0
  614.         End If
  615.  
  616.         Msg = MidiIn_Read()
  617.         If Msg = 0& Then GoTo ReadLoop_End
  618.         If (Msg And &HFF) <> &HF1 Then GoTo ReadLoop_End
  619.         oldt = newt
  620.         dd = (Msg And &HFF00) / 256
  621.         Select Case (dd And &HF0)
  622.             Case &H0:
  623.                 If Expected <> &H0 Then
  624.                     Erase_Display
  625.                     flgCatching = True
  626.                     Expected = &H0
  627.                 Else
  628.                     ln = (dd And &HF)
  629.                     Expected = &H10
  630.                 End If
  631.  
  632.             Case &H10:
  633.                 If Expected <> &H10 Then
  634.                     Erase_Display
  635.                     flgCatching = True
  636.                     Expected = &H0
  637.                 Else
  638.                     f = (dd And &HF) * 16 + ln
  639.                     Expected = &H20
  640.                 End If
  641.  
  642.             Case &H20:
  643.                 If Expected <> &H20 Then
  644.                     Erase_Display
  645.                     flgCatching = True
  646.                     Expected = &H0
  647.                 Else
  648.                     ln = (dd And &HF)
  649.                     Expected = &H30
  650.                 End If
  651.  
  652.             Case &H30:
  653.                 If Expected <> &H30 Then
  654.                     Erase_Display
  655.                     flgCatching = True
  656.                     Expected = &H0
  657.                 Else
  658.                     s = (dd And &HF) * 16 + ln
  659.                     Expected = &H40
  660.                 End If
  661.  
  662.             Case &H40:
  663.                 If Expected <> &H40 Then
  664.                     Erase_Display
  665.                     flgCatching = True
  666.                     Expected = &H0
  667.                 Else
  668.                     If flgCatching = False Then
  669.                         fff = fff + 1
  670.                         SMPTE_Adjust
  671.                         disp_fff = disp_fff + 1
  672.                         Display_Adjust
  673.                     End If
  674.                     ln = (dd And &HF)
  675.                     Expected = &H50
  676.                 End If
  677.  
  678.             Case &H50:
  679.                 If Expected <> &H50 Then
  680.                     Erase_Display
  681.                     flgCatching = True
  682.                     Expected = &H0
  683.                 Else
  684.                     m = (dd And &HF) * 16 + ln
  685.                     Expected = &H60
  686.                 End If
  687.  
  688.             Case &H60:
  689.                 If Expected <> &H60 Then
  690.                     Erase_Display
  691.                     flgCatching = True
  692.                     Expected = &H0
  693.                 Else
  694.                     ln = (dd And &HF)
  695.                     Expected = &H70
  696.                 End If
  697.  
  698.             Case &H70:
  699.                 If Expected <> &H70 Then
  700.                     Erase_Display
  701.                     flgCatching = True
  702.                     Expected = &H0
  703.                 Else
  704.                     h = (dd And &H1) * 16 + ln
  705.                     tt = (dd And &H6) / 2
  706.  
  707.                     If flgCatching = False Then
  708.                         If SMPTE_to_Frames(h, m, s, f) - SMPTE_to_Frames(hhh, mmm, sss, fff) <> 1& Then
  709.                             Erase_Display
  710.                             flgCatching = True
  711.                             Expected = &H0
  712.                         Else
  713.                             fff = fff + 1
  714.                             disp_fff = disp_fff + 1
  715.                         End If
  716.                     Else
  717.                         flgCatching = False
  718.                         hhh = h
  719.                         disp_hhh = h
  720.                         mmm = m
  721.                         disp_mmm = m
  722.                         sss = s
  723.                         disp_sss = s
  724.                         fff = f + 2
  725.                         disp_fff = f + 2
  726.                         TC_Type = tt
  727.                         Select Case tt
  728.                             Case 0:
  729.                                 Ms_per_QF = 250 / 24
  730.                                 Frame_Mode = 24
  731.                                 st = "SMPTE : 24 Fr/s"
  732.                             Case 1:
  733.                                 Ms_per_QF = 250 / 25
  734.                                 Frame_Mode = 25
  735.                                 st = "SMPTE : 25 Fr/s"
  736.                             Case 2:
  737.                                 Ms_per_QF = 250 / 29
  738.                                 Frame_Mode = 29
  739.                                 st = "SMPTE : 30 (Drop-Frame)"
  740.                             Case 3:
  741.                                 Ms_per_QF = 250 / 30
  742.                                 Frame_Mode = 30
  743.                                 st = "SMPTE : 30 (Non-Drop)"
  744.                         End Select
  745.                         If MTCForm.Caption <> st Then MTCForm.Caption = st
  746.                     End If
  747.                     SMPTE_Adjust
  748.                     Display_Adjust
  749.                     Expected = &H0
  750.                 End If
  751.  
  752.         End Select
  753.  
  754. ReadLoop_End:
  755.         DoEvents
  756.     Wend
  757. End Sub
  758.  
  759. Sub MTC_Write ()
  760.     Dim CurrentTime As Long, OldTime As Long
  761.     Dim Msg As Long
  762.  
  763.     OldTime = timeGetTime()
  764.     QF_Counter = 0
  765.     flgStop = False
  766.     While flgStop = False
  767.         CurrentTime = timeGetTime()
  768.         If CurrentTime - OldTime > Ms_per_QF Then
  769.             If QF_Send() = False Then Exit Sub
  770.             OldTime = OldTime + Ms_per_QF
  771.             QF_Counter = QF_Counter + 1
  772.             If QF_Counter = 4 Then
  773.                 disp_fff = disp_fff + 1  'Change display every frame
  774.                 Display_Adjust
  775.             ElseIf QF_Counter = 8 Then
  776.                 disp_fff = disp_fff + 1  'Change display every frame
  777.                 Display_Adjust
  778.                 fff = fff + 2            'Change MTC every two frames
  779.                 SMPTE_Adjust
  780.                 QF_Counter = 0
  781.             End If
  782.             DoEvents
  783.         End If
  784.     Wend
  785. End Sub
  786.  
  787. Sub Panic ()
  788.     ret = midiInClose(966)    'Usual Device Handles
  789.     ret = midiInClose(986)
  790.     ret = midiOutClose(966)
  791.     ret = midiOutClose(986)
  792. End Sub
  793.  
  794. Function QF_Send () As Integer
  795.     Dim tt As Long, nbl As Integer
  796.  
  797.     tt = &HF1&
  798.     Select Case QF_Counter
  799.         Case 0:
  800.             nbl = &H0 + (fff And &HF)           'f [ffff]
  801.             tt = tt + nbl * 256
  802.         Case 1:
  803.             nbl = &H10 + (fff And &H10) / 16   '[f] ffff
  804.             tt = tt + nbl * 256
  805.         Case 2:
  806.             nbl = &H20 + (sss And &HF)          'ss [ssss]
  807.             tt = tt + nbl * 256
  808.         Case 3:
  809.             nbl = &H30 + (sss And &H30) / 16    '[ss] ssss
  810.             tt = tt + nbl * 256
  811.         Case 4:
  812.             nbl = &H40 + (mmm And &HF)          'mm [mmmm]
  813.             tt = tt + nbl * 256
  814.         Case 5:
  815.             nbl = &H50 + (mmm And &H30) / 16    '[mm] mmmm
  816.             tt = tt + nbl * 256
  817.         Case 6:
  818.             nbl = &H60 + (hhh And &HF)          'h [hhhh]
  819.             tt = tt + nbl * 256
  820.         Case 7:
  821.             nbl = &H70 + (hhh And &H10) / 16    '[h] hhhh
  822.             nbl = nbl + TC_Type * 2             '[tth]
  823.             tt = tt + nbl * 256
  824.     End Select
  825.     QF_Send = MidiOut_Write(tt)
  826. End Function
  827.  
  828. 'Inicialitza el buffer de Midi In
  829. Sub Reset_BufferIn ()
  830.     flgChangeIt = False
  831.     WriteIndex = 0
  832.     ReadIndex = 0
  833.     BuffCounter = 0
  834.     flgChangeIt = True
  835. End Sub
  836.  
  837. Sub SMPTE_Adjust ()
  838.     Dim st As String
  839.  
  840.     While fff >= Frame_Mode
  841.         fff = fff - Frame_Mode
  842.         sss = sss + 1
  843.     Wend
  844.  
  845.     While sss >= 60
  846.         sss = sss - 60
  847.         mmm = mmm + 1
  848.     Wend
  849.  
  850.     While mmm >= 60
  851.         mmm = mmm - 60
  852.         hhh = hhh + 1
  853.     Wend
  854.  
  855.     While hhh >= 24
  856.         hhh = hhh - 24
  857.     Wend
  858.  
  859.     While fff < 0
  860.         fff = fff + Frame_Mode
  861.         sss = sss - 1
  862.     Wend
  863.  
  864.     While sss < 0
  865.         sss = sss + 60
  866.         mmm = mmm - 1
  867.     Wend
  868.  
  869.     While mmm < 0
  870.         mmm = mmm + 60
  871.         hhh = hhh - 1
  872.     Wend
  873.  
  874.     While hhh < 0
  875.         hhh = hhh + 24
  876.     Wend
  877.  
  878. End Sub
  879.  
  880. Function SMPTE_to_Frames (h, m, s, f) As Long
  881.     Dim rr As Long
  882.  
  883.     rr = (h * 3600& + m * 60 + s) * Frame_Mode + f
  884.     SMPTE_to_Frames = rr
  885. End Function
  886.  
  887. Function SMPTE_to_Ms (hh As Integer, mm As Integer, ss As Integer, ff As Integer) As Long
  888.     Dim rr As Long
  889.  
  890.     rr = hh * 3600000 + mm * 60000 + ss * 1000 + ff * (1000 / Frame_Mode)
  891.     SMPTE_to_Ms = rr
  892. End Function
  893.  
  894. 'Translates a Midi Error into a Message Box.
  895. Sub Alerta_MidiError (er As Integer)
  896.     Dim Msg As String
  897.  
  898.     Select Case er
  899.         Case MMSYSERR_BADDEVICEID
  900.             Msg = "Bad Device ID! "
  901.         Case MMSYSERR_NOTENABLED
  902.             Msg = "Device not Enabled!"
  903.         Case MMSYSERR_ALLOCATED
  904.             Msg = "Device allready allocated!"
  905.         Case MMSYSERR_INVALHANDLE
  906.             Msg = "Invalid Device Handle!"
  907.         Case MMSYSERR_NODRIVER
  908.             Msg = "No Driver!"
  909.         Case MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)
  910.             Msg = "Out of Memory!"
  911.         Case MMSYSERR_NOTSUPPORTED
  912.             Msg = "Function not supported!"
  913.         Case MMSYSERR_BADERRNUM
  914.             Msg = "Bad Error Number!"
  915.         Case MMSYSERR_INVALFLAG
  916.             Msg = "Invalid Flag!"
  917.         Case MMSYSERR_INVALPARAM
  918.             Msg = "Invalid Parameter!"
  919.         Case MMSYSERR_LASTERROR
  920.             Msg = "System last Error!"
  921.         Case MIDIERR_UNPREPARED
  922.             Msg = "Header unprepared!"
  923.         Case MIDIERR_STILLPLAYING
  924.             Msg = "Still Playing!"
  925.         Case MIDIERR_NOMAP
  926.             Msg = "No MIDI Mapper!"
  927.         Case MIDIERR_NOTREADY
  928.             Msg = "Hardware not ready! "
  929.         Case MIDIERR_NODEVICE
  930.             Msg = "No Device!"
  931.         Case MIDIERR_INVALIDSETUP
  932.             Msg = "Invalid Setup!"
  933.         Case MIDIERR_LASTERROR
  934.             Msg = "MIDI Last Error!"
  935.         Case Else
  936.             Msg = "Unexpected Error!"
  937.     End Select
  938.  
  939.     Dlg_Alert (Msg)
  940. End Sub
  941.  
  942. Sub Wait (tt As Long)
  943.     Dim t1 As Long, t2 As Long
  944.  
  945.     t1 = timeGetTime()
  946.     Do
  947.         t2 = timeGetTime()
  948.     Loop Until t2 - t1 >= tt
  949. End Sub
  950.  
  951.